home *** CD-ROM | disk | FTP | other *** search
- VERSION 2.00
- Begin Form FRM_Opts
- BorderStyle = 3 'Fixed Double
- Caption = "Options"
- ClientHeight = 3360
- ClientLeft = 1680
- ClientTop = 2730
- ClientWidth = 7335
- Height = 3765
- Left = 1620
- LinkMode = 1 'Source
- LinkTopic = "Form1"
- MaxButton = 0 'False
- MinButton = 0 'False
- ScaleHeight = 3360
- ScaleWidth = 7335
- Top = 2385
- Width = 7455
- Begin PictureBox pDisp
- BorderStyle = 0 'None
- FontTransparent = 0 'False
- Height = 315
- Left = 60
- ScaleHeight = 315
- ScaleWidth = 7215
- TabIndex = 0
- TabStop = 0 'False
- Top = 2910
- Width = 7215
- End
- Begin CheckBox CHK_Float
- Caption = "Float with menu bar"
- Height = 315
- Left = 240
- TabIndex = 7
- Top = 2430
- Width = 2175
- End
- Begin TextBox TXT_Message
- Height = 600
- Left = 5400
- MultiLine = -1 'True
- TabIndex = 11
- Top = 2130
- Width = 1665
- End
- Begin ComboBox CMB_Size
- Height = 300
- Left = 2610
- TabIndex = 6
- Text = "Combo1"
- Top = 1980
- Width = 1215
- End
- Begin ComboBox CMB_Font
- Height = 300
- Left = 240
- Sorted = -1 'True
- Style = 2 'Dropdown List
- TabIndex = 5
- Top = 1950
- Width = 2145
- End
- Begin ComboBox CMB_AMPM
- Height = 300
- Left = 6450
- Style = 2 'Dropdown List
- TabIndex = 10
- Top = 1530
- Width = 765
- End
- Begin TextBox TXT_Alarm
- Height = 300
- Left = 5430
- TabIndex = 9
- Top = 1530
- Width = 840
- End
- Begin ComboBox CMB_Fore
- Height = 300
- Left = 2610
- Style = 2 'Dropdown List
- TabIndex = 4
- Top = 1410
- Width = 1965
- End
- Begin ComboBox CMB_Back
- Height = 300
- Left = 240
- Style = 2 'Dropdown List
- TabIndex = 3
- Top = 1410
- Width = 1965
- End
- Begin CheckBox CHK_Alarm
- Caption = "Alarm"
- Height = 225
- Left = 5400
- TabIndex = 8
- Top = 1230
- Width = 1215
- End
- Begin CommandButton BUT_Exit
- Caption = "Exit program"
- Height = 375
- Left = 5940
- TabIndex = 2
- Top = 585
- Width = 1245
- End
- Begin CommandButton BUT_OK
- Caption = "OK"
- Default = -1 'True
- Height = 375
- Left = 5940
- TabIndex = 1
- Top = 135
- Width = 1245
- End
- Dim Colour$(0 To 20)
- Dim Col(0 To 20) As Long
- Dim pStep As Integer
- Dim cY As Integer
- Dim Ind As Integer
- Sub BUT_Exit_Click ()
- Unload FRM_Clock
- Unload FRM_Disp
- End
- End Sub
- Sub BUT_OK_Click ()
- BColour = Col(CMB_Back.ListIndex)
- FColour = Col(CMB_Fore.ListIndex)
- DispFont = CMB_Font.List(CMB_Font.ListIndex)
- DispFontSize = Val(CMB_Size.Text)
- If DispFontSize < 3 Then DispFontSize = 3
- If CHK_Alarm.Value = 1 Then IsAlarm = True
- If (TXT_Alarm.Text = "") Or (Val(TXT_Alarm.Text) = 0) Then IsAlarm = False
- If IsAlarm Then
- AlarmTime = Int(Now) + TimeValue(TXT_Alarm.Text + CMB_AMPM.List(CMB_AMPM.ListIndex))
- AlarmMessage = TXT_Message.Text
- Else
- FRM_Opts.CHK_Alarm.Value = 0
- End If
- FRM_Opts.Hide
- End Sub
- Sub CHK_Alarm_Click ()
- IsAlarm = CHK_Alarm.Value
- End Sub
- Sub CHK_Float_Click ()
- IsFloat = CHK_Float.Value
- End Sub
- Sub Form_Load ()
- Screen.MousePointer = HOURGLASS
- Move (Screen.Width - Width) / 2, (Screen.Height - Height) / 3
- FRM_Opts.Picture = FRM_Clock.Icon
- pDisp.Backcolor = BUTTON_FACE
- pDisp.Forecolor = BUTTON_TEXT
- ' setup colour combo boxes
- Colour$(0) = "Black": Colour$(1) = "Blue": Colour$(2) = "Green"
- Colour$(3) = "Cyan": Colour$(4) = "Red": Colour$(5) = "Magenta"
- Colour$(6) = "Yellow": Colour$(7) = "White": Colour$(8) = "Gray"
- Colour$(9) = "Light Blue": Colour$(10) = "Light Green": Colour$(11) = "Light Cyan"
- Colour$(12) = "Light Red": Colour$(13) = "Light Magenta": Colour$(14) = "Light Yellow"
- Colour$(15) = "Bright White"
- Colour$(16) = "Desktop": Colour$(17) = "Active title bar"
- Colour$(18) = "Inactive title bar": Colour$(19) = "Menu bar"
- Colour$(20) = "Menu bar text"
- For x% = 0 To 15
- Col(x%) = QBColor(x%)
- Next
- Col(16) = DESKTOP
- Col(17) = ACTIVE_TITLE_BAR
- Col(18) = INACTIVE_TITLE_Bar
- Col(19) = MENU_BAR
- Col(20) = MENU_BAR_TEXT
- Do While CMB_Back.ListCount > 0
- CMB_Back.RemoveItem 0
- CMB_Fore.RemoveItem 0
- Loop
- For x% = 0 To 20
- CMB_Back.AddItem Colour$(x%)
- CMB_Fore.AddItem Colour$(x%)
- Next x%
- CMB_Back.ListIndex = 16
- CMB_Fore.ListIndex = 17
- For x% = 20 To 0 Step -1
- If BColour = Col(x%) Then CMB_Back.ListIndex = x%
- If FColour = Col(x%) Then CMB_Fore.ListIndex = x%
- Next x%
- ' setup AM/PM combo box
- Do While CMB_AMPM.ListCount > 0
- CMB_AMPM.RemoveItem 0
- Loop
- CMB_AMPM.AddItem "AM"
- CMB_AMPM.AddItem "PM"
- CMB_AMPM.ListIndex = Abs(Time$ > "12:00:00")
- ' setup font size box
- Do While CMB_Size.ListCount > 0
- CMB_Size.RemoveItem 0
- Loop
- CMB_Size.AddItem "6"
- CMB_Size.AddItem "7"
- CMB_Size.AddItem "8.25"
- CMB_Size.AddItem "9.75"
- CMB_Size.AddItem "12"
- CMB_Size.AddItem "13.5"
- CMB_Size.AddItem "18"
- CMB_Size.AddItem "24"
- For x% = 0 To Screen.Fontcount - 1
- If CMB_Size.List(x%) = Format$(DispFontSize) Then CMB_Size.ListIndex = x%
- Next x%
- If CMB_Size.ListIndex = -1 Then CMB_Size.Text = Format$(DispFontSize)
- ' setup font name combo box
- Do While CMB_Font.ListCount > 0
- CMB_Font.RemoveItem 0
- Loop
- For x% = 0 To Screen.Fontcount - 1
- CMB_Font.AddItem Screen.Fonts(x%)
- Next x%
- CMB_Font.ListIndex = 1
- For x% = 0 To Screen.Fontcount - 1
- If CMB_Font.List(x%) = DispFont Then CMB_Font.ListIndex = x%
- Next x%
- If IsAlarm Then
- at$ = Format$(AlarmTime, "h:mm AM/PM")
- TXT_Alarm.Text = Left$(at$, Len(at$) - 3)
- TXT_Message.Text = AlarmMessage
- CHK_Alarm.Value = 1
- CMB_AMPM.ListIndex = Abs(Format$(AlarmTime, "h:mm") > "12:00")
- End If
- If IsFloat Then CHK_Float.Value = 1
- pStep = Int(pDisp.ScaleWidth / MaxItems) - 1
- pDisp.Fillcolor = pDisp.Backcolor
- pDisp.FillStyle = 0
- pDisp.FontSize = 7
- pDisp.FontBold = False
- cY = pDisp.ScaleHeight / 2 - pDisp.TextHeight("A") / 2
- Screen.MousePointer = DEFAULT
- End Sub
- Sub Form_Paint ()
- fs = FontSize
- fb% = FontBold
- fi% = FontItalic
- FontBold = True
- PrintLabel "Background", CMB_Back
- PrintLabel "Text", CMB_Fore
- PrintLabel "Message", TXT_Message
- FontSize = 9.75
- FontBold = True
- FontItalic = True
- CurrentX = 750
- CurrentY = 5
- Print "VBClock 2.1"
- FontSize = 8.25
- FontBold = False
- FontItalic = False
- CurrentX = 800
- Print "Visual Basic clock and system resources utility."
- Print
- CurrentX = 800
- Print "Written by Sarah Holland, July 1992."
- CurrentX = 800
- Print "Compuserve ID 70620,1425."
- FontSize = fs
- FontBold = fb%
- FontItalic = fi%
- ShowBar pStep, Int(pDisp.ScaleWidth)
- End Sub
- Sub pDisp_MouseDown (Button As Integer, Shift As Integer, x As Single, Y As Single)
- Ind = Int(x / pStep + 1)
- j% = Ind * pStep
- pDisp.Line (j% - pStep + 9, 9)-(j% - pStep + 9, pDisp.ScaleHeight - 25), BUTTON_SHADOW
- pDisp.Line (j% - pStep + 9, 9)-(j% - 9, 9), BUTTON_SHADOW
- pDisp.Line (j% - pStep + 9, pDisp.ScaleHeight - 23)-(j% - 5, pDisp.ScaleHeight - 23), BUTTON_FACE
- pDisp.Line (j% - 9, 9)-(j% - 9, pDisp.ScaleHeight - 25), BUTTON_FACE
- End Sub
- Sub pDisp_MouseUp (Button As Integer, Shift As Integer, x As Single, Y As Single)
- Dim hMenu As Integer
- Dim hSubMenu As Integer
- Dim hWnd As Integer
- If Ind <> Int(x / pStep + 1) Then
- ShowBar Ind * pStep, Ind * (pStep + 1) - 1
- Exit Sub
- End If
- Ind = Int(x / pStep + 1)
- PopUpX = Twips_To_Pixels((Ind - 1) * (pStep + 25) + FRM_Opts.Left + pDisp.Left)
- PopUpY = Twips_To_Pixels(FRM_Opts.Top + pDisp.Top - (TextHeight("A") * NumTypes))
- hMenu = GetMenu(FRM_Disp.hWnd)
- hSubMenu = GetSubMenu(hMenu, 0)
- j% = TrackPopupMenu(hSubMenu, 0, PopUpX, PopUpY, 0, FRM_Disp.hWnd, 0)
- DispInfo(Ind) = DispItem
- Unload FRM_Disp
- ShowBar Ind * pStep, Ind * (pStep + 1) - 1
- End Sub
- Sub PrintLabel (Text As String, Ctl As Control)
- CurrentX = Ctl.Left
- CurrentY = Ctl.Top - 225
- Print Text
- End Sub
- Sub ShowBar (st%, fin%)
- For x% = st% To fin% Step pStep
- pDisp.DrawWidth = 2
- pDisp.Line (x% - pStep, 0)-(x%, pDisp.ScaleHeight - 8), Forecolor, B
- pDisp.DrawWidth = 1
- pDisp.Line (x% - pStep + 9, 9)-(x% - pStep + 9, pDisp.ScaleHeight - 25), WHITE
- pDisp.Line (x% - pStep + 9, 9)-(x% - 9, 9), WHITE
- pDisp.Line (x% - pStep + 9, pDisp.ScaleHeight - 25)-(x% - 9, pDisp.ScaleHeight - 25), BUTTON_SHADOW
- pDisp.Line (x% - 5, 9)-(x% - 5, pDisp.ScaleHeight - 25), BUTTON_SHADOW
- Info$ = LTrim$(RTrim$(GetInfo(DispInfo(x% / pStep))))
- pDisp.CurrentX = (x% - (pStep / 2)) - pDisp.TextWidth(Info$) / 2
- pDisp.CurrentY = cY
- pDisp.Print Info$
- Next x%
- End Sub
- Sub TXT_Alarm_Change ()
- CHK_Alarm.Value = 1
- End Sub
-